unit pc1;

 {
    PC1 CIPHER 128-bit keys
    (c) Alexander PUKALL 1991
    (c) Evgeny.Lucenko@gmail.ru 2013
    Freeware. Can be freely use even for commercial purposes
 }

interface

type

  TPC1 = class
  const
    P3 = $015a;
    P4 = $4e35;
  private
    class procedure Init(var P1, si: Word);
    class function Assemble(var P1, si: Word; const Key: AnsiString): word;
    class function MnemoCode(Index: integer): AnsiChar; overload;
    class function MnemoCode(C: AnsiChar): byte; overload;
    class function NormalizeKey(const Key: AnsiString): AnsiString;
  public
    class function Crypt(const Key, Data: AnsiString): AnsiString;
    class function Decrypt(const Key, Data: AnsiString): AnsiString;
  end;


implementation

uses System.SysUtils, StrUtils;

{ TPC1 }

class function TPC1.Assemble(var P1, si: Word; const Key: AnsiString): word;
var
  i: integer;
  Z: array[0..7] of Word;

  function Code(Index: integer): Word;
  var
    Z1: Word;
  begin
    Z1:= Z[Index];
    Z[Index]:= Z[Index]*P4 + 1;
    P1:= P3*Z1 + (P1 + Index)*P4 + si;
    si:= P3*Z1;
    result:= Z[Index] xor P1;
  end;

begin
  Z[0]:= ( ord(Key[1])*256 ) + ord(Key[2]);
  result:= code(0);

  for i:=1 to 7 do begin
    Z[i]:= Z[pred(i)] xor ( (ord(Key[i*2 + 1])*256) + ord(Key[i*2 + 2]) );
    result:= result xor Code(i);
  end;
end;

class function TPC1.Crypt(const Key, Data: AnsiString): AnsiString;
var
  i, j: integer;
  c: Byte;
  inter, P1, si: Word;
  EncryptKey: AnsiString;
begin
  Init(P1, si);
  EncryptKey:= NormalizeKey(Key);
  SetLength(result, length(Data)*2);

	for i:=0 to Length(Data)-1 do begin
		c:= ord(Data[i+1]);
    inter:= Assemble(P1, si, EncryptKey);
		for j:= 1 to Length(Key) do
		  EncryptKey[j]:= AnsiChar(ord(EncryptKey[j]) xor c);

		c:= c xor ((inter shr 8) xor (inter and 255));
    result[i*2 + 1]:= MnemoCode(c shr 4);
    result[i*2 + 2]:= MnemoCode(c and 15);
  end;
end;

class function TPC1.Decrypt(const Key, Data: AnsiString): AnsiString;
var
  i, j, k, DataLength: integer;
  c: Byte;
  inter, P1, si: Word;
  EncryptKey: AnsiString;
begin
  Init(P1, si);
  EncryptKey:= NormalizeKey(Key);
  DataLength:= Length(Data);
  SetLength(result, Length(Data) div 2);

  try
    if (DataLength div 2) * 2 <> DataLength then
      raise Exception.Create('Bad input decrypt data');

    i:= 1;
    k:= 1;
    while i <= DataLength do begin
      c:= (MnemoCode(Data[i]) shl 4) + MnemoCode(Data[succ(i)]);
      inter:= Assemble(P1, si,  EncryptKey);
      c:= c xor ((inter shr 8) xor (inter and 255));
      result[k]:= AnsiChar(c);

      for j:= 1 to 16 do
        EncryptKey[j]:= AnsiChar(ord(EncryptKey[j]) xor c);

      inc(i, 2);
      inc(k);
    end;
  except
    result:= '';
  end;
end;

class procedure TPC1.Init(var P1, si: Word);
begin
  P1:= 0;
  si:= 0;
end;

class function TPC1.MnemoCode(C: AnsiChar): byte;
begin
  case C of
    'a' : exit(0);
    'b' : exit(1);
    'c' : exit(2);
    'd' : exit(3);
    'e' : exit(4);
    'f' : exit(5);
    'g' : exit(6);
    'h' : exit(7);
    'i' : exit(8);
    'j' : exit(9);
    'k' : exit(10);
    'l' : exit(11);
    'm' : exit(12);
    'n' : exit(13);
    'o' : exit(14);
    'p' : exit(15);
    else
      raise Exception.Create('Illegal symbol to decrypt');
  end;
end;

class function TPC1.MnemoCode(Index: integer): AnsiChar;
begin
  case Index of
    0 : exit('a');
    1 : exit('b');
    2 : exit('c');
    3 : exit('d');
    4 : exit('e');
    5 : exit('f');
    6 : exit('g');
    7 : exit('h');
    8 : exit('i');
    9 : exit('j');
    10: exit('k');
    11: exit('l');
    12: exit('m');
    13: exit('n');
    14: exit('o');
    15: exit('p');
    else begin
      Assert(False, 'Illegal data');
      result:= '*';
    end;
 end;
end;

class function TPC1.NormalizeKey(const Key: AnsiString): AnsiString;
begin
  result:= Copy(Key, 1, 16);
  result:= result + DupeString('G', 16-Length(result));
end;

end.
